C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
 
 
 
 
 
 
 
 
C                                   parameter length
 
 
 
 
 
 
 
 
 
C following are for ZYCSDT (Canonicalise Symbol Data Types)
        PROGRAM ISTPT
 
C ----------------------------------------------------------------------
C
C       I S T P T   -   Toolpack Precision Transformer
C
C       Malcolm Cohen, Numerical Algorithms Group, 1984
C
C       Changes the precision of a Fortran-77 program unit from REAL to
C       DOUBLE PRECISION and vice versa.  This is only the top level;
C       all the work is done in PTLIB.
C
C       Malcolm Cohen, Numerical Algorithms Group, 1985
C       Program ISTPT split into ISTPT and PTLIB.
C
C ----------------------------------------------------------------------
 
        INTEGER TREPTH(81),SYMPTH(81),CMIPTH(81),
     +          TKOPTH(81),CMOPTH(81),CMTPTH(81),JUNK,
     +          OPTSTR(81),IODTRE,IODSYM,IODCMI,IODCMT,IODTKO,
     +          IODCMO,NERROR,NWARN
 
 
        INTEGER OPEN,CREATE,GETARG,ZYINCI,ZTKPTI
        EXTERNAL OPEN,CREATE,ERROR,ZINIT,ZQUIT,ZYINSY,ZYINPT,ZMESS,
     +           GETARG,ZYINCI,ZCHOUT,PUTDEC,PUTC,ZTKPTI,CLOSE
 
 
C Initialise program
 
        NERROR=0
        NWARN=0
        CALL ZINIT
 
C Get parameters
 
        IF (GETARG(1,TREPTH,81).EQ.-100) CALL PTARGS(1,TREPTH)
        IF (GETARG(2,SYMPTH,81).EQ.-100) CALL PTARGS(2,SYMPTH)
        IF (GETARG(3,CMIPTH,81).EQ.-100) CALL PTARGS(3,CMIPTH)
        IF (GETARG(4,CMTPTH,81).EQ.-100) CALL PTARGS(4,CMTPTH)
        IF (GETARG(5,TKOPTH,81).EQ.-100) CALL PTARGS(5,TKOPTH)
        IF (GETARG(6,CMOPTH,81).EQ.-100) CALL PTARGS(6,CMOPTH)
        IF (GETARG(7,OPTSTR,81).EQ.-100) CALL PTARGS(7,OPTSTR)
 
C Open files
 
        IODTRE=OPEN(TREPTH,0)
        IF (IODTRE.EQ.-1) CALL ERROR('Can''t open parse tree')
        IODSYM=OPEN(SYMPTH,0)
        IF (IODSYM.EQ.-1) CALL ERROR('Can''t open symbol table')
        IODCMI=OPEN(CMIPTH,0)
        IF (IODCMI.EQ.-1) CALL ERROR('Can''t open comment index')
        IODCMT=OPEN(CMTPTH,0)
        IF (IODCMT.EQ.-1) CALL ERROR('Can''t open comment file')
        IODTKO=CREATE(TKOPTH,1)
        IF (IODTKO.EQ.-1) CALL ERROR('Can''t create token stream')
        IODCMO=CREATE(CMOPTH,1)
        IF (IODCMO.EQ.-1) CALL ERROR('Can''t create comment stream')
 
C Read input
 
        CALL ZYINPT(IODTRE)
        CALL CLOSE(IODTRE)
        CALL ZYINSY(IODSYM)
        CALL CLOSE(IODSYM)
        IF (ZYINCI(IODCMI).NE.-2) CALL ERROR('ZYINCI failed')
 
C Process input
 
        CALL PT(OPTSTR,IODCMT,ZTKPTI(1,IODTKO,IODCMO),NERROR,NWARN)
 
C Terminate
 
        IF (NERROR+NWARN.EQ.0) THEN
            CALL ZMESS('[ISTPT Normal Termination]',1)
            CALL ZQUIT(-2)
        ELSE IF (NERROR.EQ.0) THEN
            CALL ZCHOUT('[ISTPT Terminated with ',1)
            CALL PUTDEC(NWARN,1)
            CALL ZCHOUT(' war'//'ning',1)
            IF (NWARN.GT.1) CALL PUTC(115)
            CALL ZMESS(']',1)
            CALL ZQUIT(-1002)
        ELSE
            CALL ZCHOUT('[ISTPT Error Termination, ',1)
            CALL PUTDEC(NERROR,1)
            CALL ZCHOUT(' er'//'ror',1)
            IF (NERROR.GT.1) CALL PUTC(115)
            CALL ZMESS(']',1)
            CALL ZQUIT(-1)
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       P T A R G S   -   Get ISTPT command arguments from user
C
 
        SUBROUTINE PTARGS(NUMBER,PATH)
        INTEGER NUMBER,PATH(81)
 
        INTEGER PROMPT(24,7),I
 
        SAVE PROMPT
 
        INTEGER ZGTCMD
        EXTERNAL ZGTCMD,ZPRMPT
 
C "Input parse tree: "
C "Input symbol table: "
C "Input comment index: "
C "Input comment stream: "
C "Output token stream: "
C "Output comment stream: "
C "Options: "
 
        DATA (PROMPT(I,1),I=1,19)/73,110,112,117,116,32,112,
     +97,114,115,101,32,116,114,101,101,58,32,129/,
     +       (PROMPT(I,2),I=1,21)/73,110,112,117,116,32,115,
     +121,109,98,111,108,32,116,97,98,108,101,58,
     +32,129/,
     +       (PROMPT(I,3),I=1,22)/73,110,112,117,116,32,99,
     +111,109,109,101,110,116,32,105,110,100,101,120,
     +58,32,129/,
     +       (PROMPT(I,4),I=1,23)/73,110,112,117,116,32,99,
     +111,109,109,101,110,116,32,115,116,114,101,97,109,
     +58,32,129/,
     +       (PROMPT(I,5),I=1,22)/79,117,116,112,117,116,32,
     +116,111,107,101,110,32,115,116,114,101,97,109,
     +58,32,129/,
     +       (PROMPT(I,6),I=1,24)/79,117,116,112,117,116,32,
     +99,111,109,109,101,110,116,32,115,116,114,101,97,
     +109,58,32,129/,
     +       (PROMPT(I,7),I=1,10)/79,112,116,105,111,110,115,
     +58,32,129/
 
        CALL ZPRMPT(PROMPT(1,NUMBER))
        I=ZGTCMD(PATH,0)
 
        END
C ----------------------------------------------------------------------
C
C       A D D S T R   -   Add string to string table
C
 
        INTEGER FUNCTION ADDSTR(STRING)
        INTEGER STRING(*)
 
        INTEGER ZYASTR
        EXTERNAL ZYASTR
 
        ADDSTR=ZYASTR(STRING)
 
        END
